UNIT APEcon;{APE 1.0 Copyright ⌐ 1988, Peter Wayner}{This is the code for version 1.0 of the APE compiler developed by Peter Wayner}{at Cornell University's Department of Computer Science. It is NOT in the public}{domain. It cannot be included as part of any other software without the }{written permission of the author.}{A version with windows, a much friendlier interface and a manual}{available for $45 from the author at 119 Ferris Place, Ithaca, NY 14850.}{A version for the IBM-PC is also available at the same price.}INTERFACE USES APEglobals, APEdata, APEutil; PROCEDURE parsem; {The nerve center for equation parsing.}IMPLEMENTATION PROCEDURE push; {Pushes new data onto the stack.} VAR old : stackpoint; {The old stackpointer.} BEGIN old := stacktop; new(stacktop); stacktop^.up := old; stacktop^.curleft := 0; stacktop^.curright := 0; stacktop^.curcon := 0; stacktop^.state := 1 END;{push} PROCEDURE pop; {Pops the old data off the stack. } VAR old : stackpoint; BEGIN old := stacktop; stacktop := stacktop^.up; dispose(old) END;{pop} FUNCTION storephrase : integer; {Takes the current phrase at the top of the stack and stores it away.} {Returns a phraseid.} VAR p1 : phrase; {The phrase to be stored away.} symetric : integer; {Set to 0 if it is a symetric connector 1 if left and 2 if right.} duplicate : boolean; {A boolean that is returned from addphrase true if the token exists before.} tempid : integer; {A temporary register to hold storephrase.} dagnode : dagpoint; {The potential new dagnode.} reversed : boolean; {Set to true if the program needs to rearrange the phrase.} BEGIN p1[2] := stacktop^.curcon; CASE tokenmap[p1[2]]^.symetric OF 0 : {symetric} IF stacktop^.curleft < stacktop^.curright THEN BEGIN p1[1] := stacktop^.curleft; p1[3] := stacktop^.curright; reversed := false END ELSE BEGIN p1[1] := stacktop^.curright; p1[3] := stacktop^.curleft; reversed := true END; 1 : {left} BEGIN p1[1] := stacktop^.curleft; p1[3] := stacktop^.curright; reversed := false END; 2 : {The right branch must be explored first.} BEGIN p1[3] := stacktop^.curleft; p1[1] := stacktop^.curright; reversed := true; END END; symetric := tokenmap[p1[2]]^.symetric; addphrase(p1, symetric, reversed, tempid, duplicate); {Update the phrasemin array. This new connection obviously holds the } {minimum of the two leaves.} IF NOT duplicate THEN BEGIN new(dagnode); dagnode^.phraseid := tempid; dagnode^.visited := false; {Initialize the tree.} dagnode^.top := true;{It must be the top, since it's never been here before.} dagmap[tempid] := dagnode; {Put it in the table.} dagnode^.left := dagmap[p1[1]]; dagnode^.left^.top := false; {Because they're not the tops anymore.} dagnode^.right := dagmap[p1[3]]; dagnode^.right^.top := false; {This segment helps find the minimum phrase number for sorting and printing out} {the tree in order.} IF phrasemin[p1[1]] < phrasemin[p1[3]] THEN phrasemin[tempid] := phrasemin[p1[1]] ELSE phrasemin[tempid] := phrasemin[p1[3]]; END; storephrase := tempid; END;{storephrase} PROCEDURE parseline (VAR errorflag, sectionend : boolean); {Takes a line of equations and parses it. Adds it to the data base} {Using storephrase. Returns a false if an error occurs.} VAR {Receives tokenlist and tokencount globally. Also errorflag.} curtoken : integer; {A counter that points to the current token being parsed.} synthtoken : integer; {The latest synthesized token.} wordlist : ARRAY[1..wordsperline] OF integer; {A local list of the words in a line.} tokenlist : ARRAY[1..tokensperline] OF integer; {The results of condensing the wordlist into tokens.} listcount : integer; {An integer to count through the array wordlist.} tokencount : integer; {An integer to count through tokenlist. Points to last token in list.} old : stackpoint; {A variable for blowing the stack.} {Other variables are held on the stack accessed with push and pop.} {They are: } {curleft= the left hand token. } {curright=the right hand token. } {curcon=the current connector. } {state= 1 if completely empty. } { =2 if just filled curleft. } { =3 if just filled curcon. } { =4 if just filled curright. } { =5 if waiting to complete an equivalence assignment. } PROCEDURE grabline; {grabs the next line and converts it into word uids.} VAR {Brings in the global array wordlist.} w1 : word; {The temporary word storage.} endoline : boolean; {A loop invariant that is false until an end to the line is found.} placeholder : tablepoint; {The pointer to the current id.} i : integer; {a counter.} stopchar : char; {a variable to hold the stopping character detected.} BEGIN listcount := 0; endoline := false; WHILE NOT endoline DO BEGIN w1 := nextword(stopchar); IF w1[1] <> ' ' THEN IF checkword(w1, placeholder) THEN BEGIN listcount := listcount + 1; wordlist[listcount] := placeholder^.uid END ELSE BEGIN writeln(outputfile, 'Word left undefined:'); scriptword(w1); errorflag := true END; CASE stopchar OF ';' : BEGIN listcount := listcount + 1; wordlist[listcount] := -1; endoline := true END; '(' : BEGIN listcount := listcount + 1; wordlist[listcount] := -2 END; ')' : BEGIN listcount := listcount + 1; wordlist[listcount] := -3 END; '.' : BEGIN listcount := listcount + 1; wordlist[listcount] := -4; endoline := true END; '=' : BEGIN listcount := listcount + 1; wordlist[listcount] := -5 END; ' ', ':' : ; {That's right, do nothing with a colon as well.} END;{case statement.} IF eof(inputfile) THEN endoline := true END;{ The while loop.} END;{grabline} PROCEDURE condenseline; {Takes a line and condenses it into tokens.} VAR {Takes wordlist as a global and returns tokenlist as a global.} {listcount is a global set to the last word in the list.} {tokencount is global set to the last token on the list.} curword : integer; {A pointer to the current word on wordlist.} t1 : token; {A data structure to search for tokens.} tcount : integer; {Place in the token list.} tokenidea : boolean; {True if the current token is an idea.} placeholder : tokenpoint; {This time a pointer to the place in the token list.} i : integer;{*destroy me*} LABEL 888; BEGIN curword := 1; tokencount := 0; tcount := 0; tokenidea := true; {Assume we start in this condition.} REPEAT IF wordlist[curword] < 0 THEN BEGIN IF tcount > 0 THEN {A token exists. Store it.} BEGIN WHILE tcount < wordspertoken DO BEGIN tcount := tcount + 1; {Pad the token.} t1[tcount] := 0 END; IF findtoken(t1, placeholder) THEN {Found!} BEGIN tokencount := tokencount + 1; tokenlist[tokencount] := placeholder^.tokenid; tcount := 0; END ELSE BEGIN writeln(outputfile, 'This line contains an undefined token.'); errorflag := true; curword := listcount + 1;{Blow us out of the loop.} GOTO 888 END {Now the token is found and stored away or an error is generated.} {Take care of that punctuation.} END; tokencount := tokencount + 1; tokenlist[tokencount] := wordlist[curword]; END ELSE {It is a regular word.} BEGIN IF tokenidea = uidmap[wordlist[curword]]^.idea THEN {They agree. Save and continue.} BEGIN tcount := tcount + 1; t1[tcount] := wordlist[curword] {Add the new word.} END ELSE BEGIN {They don't agree so some saving must be done.} IF tcount > 0 THEN {A token exists. Store it.} BEGIN WHILE tcount < wordspertoken DO BEGIN tcount := tcount + 1; {Pad the token.} t1[tcount] := 0 END; IF findtoken(t1, placeholder) THEN {Found!} BEGIN tokencount := tokencount + 1; tokenlist[tokencount] := placeholder^.tokenid END ELSE BEGIN error('This line contains an undefined token.'); errorflag := true; curword := listcount + 1;{Blow us out of the loop.} GOTO 888 END END; {The old one is done. Save the new one.} tcount := 1; t1[1] := wordlist[curword]; tokenidea := uidmap[t1[1]]^.idea;{ Is the current t1 an idea or what.} END END; curword := curword + 1;{Keep going through the list.}888 : UNTIL curword > listcount; END;{condenseline} {Now the real work of parse line.} BEGIN errorflag := false;{Start anew.} grabline;{Get the next line of words.} IF NOT errorflag THEN condenseline; {Condense it into tokens. tokenlist and tokencount are set.} stacktop := NIL; push;{Begin with a clean stack. Sets the state to 1.} curtoken := 1; WHILE (curtoken <= tokencount) AND NOT errorflag DO BEGIN IF tokenlist[curtoken] < 0 THEN BEGIN {Handle the punctuation.} CASE tokenlist[curtoken] OF -2 : {The Left parenthesis.} push; {This is easy!} -3 : {The right parenthesis.} BEGIN IF (stacktop^.state = 4) THEN synthtoken := storephrase {Store it away. Returns a token.} ELSE IF stacktop^.state = 2 THEN synthtoken := stacktop^.curleft ELSE BEGIN error('Left and right parenthesis must contain a complete phrase.'); errorflag := true END; IF stacktop^.up = NIL THEN {Error!} BEGIN error('Mismatched parenthesis.'); errorflag := true END ELSE pop;{It's been stored away. Now take this number and store it again.} CASE stacktop^.state OF 1 : BEGIN stacktop^.curleft := synthtoken; stacktop^.state := 2 END; 3 : BEGIN stacktop^.curright := synthtoken; stacktop^.state := 4 END; 2, 4 : BEGIN error('A phrase (idea connector idea) forms a new idea.'); errorflag := true END; 5 : BEGIN {Start by pointing the current idea toward the top of the } {discovered phrase.} dagmap[stacktop^.curleft] := dagmap[synthtoken]; phrasemap[synthtoken]^.equals := stacktop^.curleft; {Here, set up a pointer to the equas sign.} pop; stacktop^.state := 2;{Put us back to normal} stacktop^.curleft := synthtoken {and so gently set us back where we are and make the equals transparent.} END; {Here we need to fit the equals sign into the stack.} {What needs to be done:} {1. This location in the stack should be attached to the id.} {2. A back pointer must be established so printing can take } { place.} END;{case statement on stacktop^.state.} END;{-3, the right parenthesis.} -5 : {The equals sign.} BEGIN IF stacktop^.state = 2 THEN {Everything is great.} BEGIN stacktop^.state := 5;{Go into equalsign waiting.} push END ELSE BEGIN error('An equal s sign must be proceded by a single idea.'); errorflag := true END END;{-5 the equals sign.} -1, -4 :{The end of the line. A semi-colon or a period.} BEGIN IF stacktop^.up <> NIL THEN {Trouble. Parenthesis don't balance.} IF stacktop^.up^.state = 5 THEN {finish off this equals sign.} BEGIN {Start by pointing the current idea toward the top of the } {discovered phrase.} dagmap[stacktop^.up^.curleft] := dagmap[synthtoken]; END ELSE BEGIN error('Parenthesis do not balance.'); errorflag := true END {curtoken must equal tokencount.} ELSE IF (stacktop^.state = 4) THEN synthtoken := storephrase{Store it away. Returns a token.} ELSE IF stacktop^.state <> 2 THEN BEGIN error('Phrases must consist of idea-connector-idea.'); errorflag := true END END;{of the semi-colon and period. -1 and -4} END{of the case statement.} END {of punctuation section.} ELSE BEGIN {The section that scores the tokens.} CASE stacktop^.state OF 1 : {Nothing parsed yet.} IF tokenmap[tokenlist[curtoken]]^.idea = true THEN {all is cool.} BEGIN stacktop^.curleft := tokenlist[curtoken]; stacktop^.state := 2 END ELSE BEGIN error('The first token of a phrase must be an idea.'); errorflag := true END; 2 : {Waiting for an idea.} IF tokenmap[tokenlist[curtoken]]^.idea <> true THEN {all is cool.} BEGIN stacktop^.curcon := tokenlist[curtoken]; stacktop^.state := 3 END ELSE BEGIN error('The second token of a phrase must be a connector.'); errorflag := true END; 3 :{All eyes on right.} IF tokenmap[tokenlist[curtoken]]^.idea = true THEN {all is cool.} BEGIN stacktop^.curright := tokenlist[curtoken]; stacktop^.state := 4 END ELSE BEGIN error('The third token of a phrase must be an idea.'); errorflag := true END; 4 :{Could be trouble.} IF tokenmap[tokenlist[curtoken]]^.idea <> true THEN {all is cool.} BEGIN {idea-connector-idea-connector. Implied parenthesis.} stacktop^.curleft := storephrase; stacktop^.curcon := tokenlist[curtoken]; stacktop^.state := 3 END ELSE BEGIN error('The ideas and the connectors must alternate.'); errorflag := true END; 5 : ;{Shouldn't be here.} END;{ of the case statement} END;{of the if statement.} curtoken := curtoken + 1; END;{of invarient curtoken<=tokencount. Everything must be processed.}{Blow out the stack. Clean up.} WHILE stacktop <> NIL DO BEGIN old := stacktop; stacktop := stacktop^.up; dispose(old) END; IF wordlist[listcount] = -4 THEN {Period, end of secton.} sectionend := true END;{parseline} PROCEDURE parsem; {The nerve center for equation parsing.} VAR sectionend : boolean; {To be passed back and forth to signal the end.} errorflag : boolean; {The local error flag to be passed back and forth .} BEGIN sectionend := false; errorflag := false; REPEAT BEGIN parseline(errorflag, sectionend); IF errorflag THEN BEGIN mastererror := true; errorflag := false END END UNTIL sectionend OR eof(inputfile); END;{parsem.}END.{box4con2}
================================
APTDATA
================================
UNIT APEdata;{APE 1.0 Copyright ⌐ 1988, Peter Wayner}{This is the code for version 1.0 of the APE compiler developed by Peter Wayner}{at Cornell University's Department of Computer Science. It is NOT in the public}{domain. It cannot be included as part of any other software without the }{written permission of the author.}{A version with windows, a much friendlier interface and a manual}{available for $45 from the author at 119 Ferris Place, Ithaca, NY 14850.}{A version for the IBM-PC is also available at the same price.}{This contains the central routines for data access of the symbol}{table and the stack.}INTERFACE USES APEglobals, APEutil; FUNCTION checkword (VAR name : word; VAR placeholder : tablepoint) : boolean; PROCEDURE addword (VAR name : word; idea : boolean; VAR uid : integer); FUNCTION findtoken (VAR t1 : token; VAR placeholder : tokenpoint) : boolean; PROCEDURE addtoken (VAR t1 : token; idea : boolean; symetric : integer; connection : boolean; VAR tokenid : integer; VAR duplicate : boolean); FUNCTION findphrase (VAR p1 : phrase; VAR placeholder : phrasepoint) : boolean; PROCEDURE addphrase (VAR p1 : phrase; symetric : integer; reversed : boolean; VAR phraseid : integer; VAR duplicate : boolean);IMPLEMENTATION FUNCTION hash (name : word) : integer; {This function takes a word and hashes it to return a number} {From 0 to hashsize.} BEGIN hash := (ord(name[1]) + ord(name[2]) + ord(name[3])) MOD hashsize + 1 END; FUNCTION checkword; {(var name : word;} {var placeholder : tablepoint) : boolean;} {This procedure takes a word and finds it in the symbol table. } {It returns true if word is found as well as a pointer to the place} {in the table the word is kept. If it returns false, placeholder } {contains the last place where the search terminated.} VAR hashed : integer; {The result of the hash.} notbottom : boolean; {A boolean variable to signal the bottom of a table.} BEGIN hashed := hash(name); {Find a binary tree to begin searching.} IF hashmap[hashed] = NIL THEN BEGIN checkword := false;{Obviously not found.} placeholder := NIL; {Return nothing.} END ELSE {The location already holds a value. Continue on.} BEGIN placeholder := hashmap[hashed];{Load the value for the invarient.} notbottom := true;{Can't be there yet.} WHILE (name <> placeholder^.name) AND notbottom DO BEGIN IF name < placeholder^.name THEN IF placeholder^.left = NIL THEN notbottom := false {The left bottom has been reached.} ELSE placeholder := placeholder^.left {Or consider the right hand side.} ELSE IF placeholder^.right = NIL THEN notbottom := false {The right bottom is reached.} ELSE placeholder := placeholder^.right; END;{While loop.} {An end is found.} checkword := notbottom; END;{Else statement begin.} END;{checkword} PROCEDURE addword; {(var name : word;} {idea : boolean;} {var uid : integer);} {This function returns the uid. idea and symetric are two traits to be stored} {along side the word.} VAR placeholder : tablepoint; {The pointer to the place of insertion.} oldplace : tablepoint; {The last placeholder.} hashed : integer; {The integer for the hash array.} BEGIN IF checkword(name, placeholder) THEN {checkword returns a location in placeholder.} {If this is true then trouble! Signal error.} BEGIN IF (NOT idea) AND placeholder^.idea THEN BEGIN error('Words in a Connector cannot duplicate an Idea. '); uid := 0; {Return a zero to signify trouble.} END ELSE uid := placeholder^.uid; END ELSE BEGIN oldplace := placeholder;{Save the old record.} new(placeholder); IF oldplace = NIL THEN {Then this section of the hash table hasn't been used.} BEGIN hashed := hash(name); hashmap[hashed] := placeholder END ELSE IF name < oldplace^.name THEN {Then we're already deep in the table.} oldplace^.left := placeholder ELSE oldplace^.right := placeholder; placeholder^.name := name; placeholder^.idea := idea; placeholder^.left := NIL; placeholder^.right := NIL; IF lastuid < maxuid THEN BEGIN lastuid := lastuid + 1; placeholder^.uid := lastuid; uid := lastuid {Return this value.} END ELSE BEGIN error('Too many ideas.');{Signal an overflow } stop END; uidmap[lastuid] := placeholder{Fill in the second table.} END END;{addword}{Now add the tokens.} FUNCTION findtoken;{(var t1 : token;} {var placeholder : tokenpoint) : boolean;} {This procedure takes a token and finds it in the symbol table. } {It returns true if token is found as well as a pointer to the place} {in the table the token is kept. If it returns false, placeholder } {contains the last place where the search terminated.} VAR notbottom : boolean; {A boolean variable to signal the bottom of a table.} BEGIN {Binary tree searching begins at tokentop} IF tokentop = NIL THEN BEGIN findtoken := false;{Obviously not found.} placeholder := NIL; {Return nothing.} END ELSE {The location already holds a value. Continue on.} BEGIN placeholder := tokentop;{Load the value for the invarient.} notbottom := true;{Can't be there yet.} WHILE (NOT equaltoken(t1, placeholder^.t1)) AND notbottom DO BEGIN IF lesstoken(t1, placeholder^.t1) THEN IF placeholder^.left = NIL THEN notbottom := false {The left bottom has been reached.} ELSE placeholder := placeholder^.left {Or consider the right hand side.} ELSE IF placeholder^.right = NIL THEN notbottom := false {The right bottom is reached.} ELSE placeholder := placeholder^.right; END;{While loop.} {An end is found.} findtoken := notbottom; END;{Else statement begin.} END;{findtoken} PROCEDURE addtoken;{(var t1 : token;} {idea:boolean; symetric:integer;connection : boolean;} {var tokenid:integer;} {var duplicate:boolean);} {This function returns the tokenid in tokenid if t1 is added to the symbol table successfully} {and zero if a match is found. idea and symetric are two traits to be stored} {along side the token. } VAR placeholder : tokenpoint; {The pointer to the place of insertion.} oldplace : tokenpoint; {The last placeholder.} dagnode : dagpoint; {The pointer to the nodes of the directed acyclic graph holding the final form.} BEGIN IF findtoken(t1, placeholder) THEN {findtoken returns a location in placeholder.} BEGIN duplicate := true; tokenid := placeholder^.tokenid END ELSE BEGIN oldplace := placeholder;{Save the old record.} new(placeholder); IF oldplace = NIL THEN {Then tabletop hasn't been used.} tokentop := placeholder ELSE IF lesstoken(t1, oldplace^.t1) THEN {Then we're already deep in the table.} oldplace^.left := placeholder ELSE oldplace^.right := placeholder; placeholder^.t1 := t1; placeholder^.idea := idea; placeholder^.symetric := symetric; placeholder^.connection := connection; placeholder^.left := NIL; placeholder^.right := NIL; IF lasttokenid < maxtokenid THEN BEGIN lasttokenid := lasttokenid + 1; lastphraseid := lastphraseid + 1; phrasemap[lastphraseid] := NIL;{Tell the map that this is blank.} phrasemin[lastphraseid] := lastphraseid; {Now add a leaf in the DAG for later printouts....} {These things are known as phrases.} new(dagnode); dagnode^.phraseid := lastphraseid; dagnode^.left := NIL; dagnode^.right := NIL; dagnode^.visited := false; dagnode^.top := false;{A leaf can never be the tops. Only composites.} dagmap[lastphraseid] := dagnode; placeholder^.tokenid := lasttokenid END ELSE BEGIN error('Too many ideas.');{Signal an overflow } stop END; tokenmap[lasttokenid] := placeholder; duplicate := false; tokenid := lasttokenid {save it for posterity.} END END;{addtoken} FUNCTION findphrase;{(var p1 : phrase;} {var placeholder : phrasepoint) : boolean;} {This procedure takes a phrase and finds it in the symbol table. } {It returns true if phrase is found as well as a pointer to the place} {in the table the phrase is kept. If it returns false, placeholder } {contains the last place where the search terminated.} VAR notbottom : boolean; {A boolean variable to signal the bottom of a table.} BEGIN {Binary tree searching begins at phrasetop} IF phrasetop = NIL THEN BEGIN findphrase := false;{Obviously not found.} placeholder := NIL; {Return nothing.} END ELSE {The location already holds a value. Continue on.} BEGIN placeholder := phrasetop;{Load the value for the invarient.} notbottom := true;{Can't be there yet.} WHILE (NOT equalphrase(p1, placeholder^.p1)) AND notbottom DO BEGIN IF lessphrase(p1, placeholder^.p1) THEN IF placeholder^.left = NIL THEN notbottom := false {The left bottom has been reached.} ELSE placeholder := placeholder^.left {Or consider the right hand side.} ELSE IF placeholder^.right = NIL THEN notbottom := false {The right bottom is reached.} ELSE placeholder := placeholder^.right; END;{While loop.} {An end is found.} findphrase := notbottom; END;{Else statement begin.} END;{findphrase} PROCEDURE addphrase;{(var p1 : phrase;} { symetric: integer;reversed:boolean;} {var phraseid:integer;} {var duplicate:boolean);} {This function returns the phraseid in phraseid if p1 is added to the symbol table successfully} {and zero if a match is found. idea and symetric are two traits to be stored} {along side the phrase. } VAR placeholder : phrasepoint; {The pointer to the place of insertion.} oldplace : phrasepoint; {The last placeholder.} BEGIN IF findphrase(p1, placeholder) THEN {findphrase returns a location in placeholder.} BEGIN duplicate := true; phraseid := placeholder^.phraseid END ELSE BEGIN oldplace := placeholder;{Save the old record.} new(placeholder); IF oldplace = NIL THEN {Then tabletop hasn't been used.} phrasetop := placeholder ELSE IF lessphrase(p1, oldplace^.p1) THEN {Then we're already deep in the table.} oldplace^.left := placeholder ELSE oldplace^.right := placeholder; placeholder^.p1 := p1; placeholder^.symetric := symetric; placeholder^.reversed := reversed; placeholder^.equals := 0;{It doesn't equal anything if nothing's been done.} placeholder^.left := NIL; placeholder^.right := NIL; IF lastphraseid < maxphraseid THEN BEGIN lastphraseid := lastphraseid + 1; lasttokenid := lasttokenid + 1;{Update here as well to make sure the} {parser works correctly. It assumes the token number=phrasenumber} tokenmap[lasttokenid] := NIL; placeholder^.phraseid := lastphraseid END ELSE BEGIN error('Too many ideas.');{Signal an overflow } stop END; phrasemap[lastphraseid] := placeholder; duplicate := false; phraseid := lastphraseid {save it for posterity.} END END;{addphrase}END.
================================
APTGLOBA.LS
================================
UNIT APEglobals;{APE 1.0 Copyright ⌐ 1988, Peter Wayner}{This is the code for version 1.0 of the APE compiler developed by Peter Wayner}{at Cornell University's Department of Computer Science. It is NOT in the public}{domain. It cannot be included as part of any other software without the }{written permission of the author.}{A version with windows, a much friendlier interface and a manual}{available for $45 from the author at 119 Ferris Place, Ithaca, NY 14850.}{A version for the IBM-PC is also available at the same price.}INTERFACE{ Global constants. } CONST linesize = 90; {The maximum length of a line of text.} wordsize = 14; {The maximum size of a word.} maxuid = 1024; {The maximum number of universal identifiers.} hashsize = 10; {The hash table runs from 0 to hashsize.} wordspertoken = 5; {The maximum number of words per token.} maxtokenid = 1024; {The maximum number of tokens.} wordsperline = 150; {number of words per line in an equation (connection).} tokensperline = 100; {Maximum number of tokens in an equation line.} maxphraseid = 1024; {The maximum number of phrases allowed.} {Must be equal to maxtokenid!!!! They are one in the same.} TYPE word = PACKED ARRAY[1..wordsize] OF char; {A word is a kludged bit of work to deal with PASCAL's lexical intransagence.} {A word is effectively the length of an id.}{This structure is used to store the symbol table.} tablepoint = ^symbol; symbol = RECORD uid : integer; {A unique id for each word.} name : word; {The name stored here.} idea : boolean;{A truth value for idea=true, connector=false} left, right : tablepoint;{Pointers to the left and right branches.} {The left points to words <name and right points to those > name.} END; pointarray = ARRAY[1..maxuid] OF tablepoint; {The array that will contain the uid-> symbol map.} hasharray = ARRAY[0..hashsize] OF tablepoint; {Use the function hash and then use hash array to find the first symbol.}{This structure is used to store the token table. Tokens consist of arrays}{of uids. } token = ARRAY[1..wordspertoken] OF integer; tokenpoint = ^tokenrecord; tokenrecord = RECORD tokenid : integer; {A unique id for each word.} t1 : token; {The name stored here.} idea : boolean;{A truth value for idea=true, connector=false} symetric : integer;{0=symmetric,1=left first,2=right first} connection : boolean;{A synthesized word.} left, right : tokenpoint;{Pointers to the left and right branches.} {The left points to words <name and right points to those > name.} END; tokenarray = ARRAY[1..maxtokenid] OF tokenpoint; {This array will contain the map of tokenid -> tokenrecord}{This is a stack used by the parser.} stackpoint = ^stackrecord; stackrecord = RECORD curleft : integer;{The uid of the left token} curcon : integer;{The uid of the connector} curright : integer;{The uid of the right token} up : stackpoint;{The way up.} state : 1..5;{The current state of the parser.} END;{This is the data types for storing phrases.} phrase = ARRAY[1..3] OF integer; {An idea-connector-idea triplet.} phrasepoint = ^phraserecord; phraserecord = RECORD phraseid : integer; {A unique id for each word.} p1 : phrase; {The name stored here.} symetric : integer;{0=symmetric,1=left first,2=right first} reversed : boolean;{This is true if the program has reversed the order of the phrase.} equals : integer;{This is a pointer to another tokenid if an equals sign assigns it to this phrase.} left, right : phrasepoint;{Pointers to the left and right branches.} {The left points to words <name and right points to those > name.} END; phrasearray = ARRAY[1..maxphraseid] OF phrasepoint; {This array will contain the map of phraseid -> phraserecord} phrasedata = ARRAY[1..maxphraseid] OF integer; {This will contain data about the phrases.}{This section contains the data type for the directed acyclic graph }{that summarizes the structure of the essay.} dagpoint = ^dagrecord; dagrecord = RECORD phraseid : integer; {The phrase id of this node. Duplicates an entry in the phrasetree.} left, right : dagpoint; {Pointers to the children.} visited : boolean; {Used in depth-first search.} top : boolean; {This is true if there is nothing with a node that points down to it.} END; dagarray = ARRAY[1..maxphraseid] OF dagpoint; {Holds the map between phraseid and node in the dag.} VAR lastuid : integer; {Last uid assigned. Should never exceed maxuid.} uidmap : pointarray; {The array that contains the uid-> symbol map.} hashmap : hasharray; {The array that contains the hash table.} tokenmap : tokenarray; {Contains the tokenid -> tokenrecord table.} lasttokenid : integer; {Last tokenid assigned.} tokentop : tokenpoint; {Pointer to the top of the token stack.} stacktop : stackpoint; {The top of the stack.} phrasetop : phrasepoint; {Pointer to the top of the phrase tree.} phrasemap : phrasearray; {Contains the phraseid -> phraserecord table.} phrasemin : phrasedata; {Contains the smallest tokenid held in the tree below a value.} lastphraseid : integer; {Last phraseid assigned.} dagmap : dagarray; {Contains a map from phraseid to dat.} ideanum, connum, equnum : integer; {Integers to hold the numbers of the global tokens } {IDEAS,CONNECTORS,CONNECTIONS respectively.} leftnum, rightnum, symnum : integer;{Integers to hold the numbers of the global tokens } {LEFT,RIGHT,SYMETRIC respectively.} mastererror : boolean; {This flag is set to stop complilation.} inputfile, outputfile : text; inputname, outputname : Str255;IMPLEMENTATIONEND.
================================
APTUTIL
================================
UNIT APEutil;{APE 1.0 Copyright ⌐ 1988, Peter Wayner}{This is the code for version 1.0 of the APE compiler developed by Peter Wayner}{at Cornell University's Department of Computer Science. It is NOT in the public}{domain. It cannot be included as part of any other software without the }{written permission of the author.}{A version with windows, a much friendlier interface and a manual}{available for $45 from the author at 119 Ferris Place, Ithaca, NY 14850.}{A version for the IBM-PC is also available at the same price.}INTERFACE USES APEglobals; PROCEDURE error (cause : STRING); PROCEDURE warning (cause : STRING); PROCEDURE stop; FUNCTION wordify (st : STRING) : word; FUNCTION equaltoken (VAR t1, t2 : token) : boolean; {Returns true if t1=t2.} FUNCTION lesstoken (VAR t1, t2 : token) : boolean; {Returns true if t1<t2.} FUNCTION equalphrase (VAR p1, p2 : phrase) : boolean; {Returns true if p1=p2.} FUNCTION lessphrase (VAR p1, p2 : phrase) : boolean; {Returns true if p1<p2.} PROCEDURE scriptword (VAR w1 : word); {Writes out a line.} PROCEDURE scripttoken (VAR t1 : token); {Writes out a token.} FUNCTION nextword (VAR stopchar : char) : word; PROCEDURE skiptoend (VAR stopchar : char); {Skips over everything until it hits a stop character.}IMPLEMENTATION PROCEDURE error; {(cause : string)} {If an error is found. Print it out!} BEGIN writeln(outputfile, cause) END;{error} PROCEDURE warning;{(cause : string)} {Just a warning, son.} BEGIN writeln(outputfile, cause) END;{warning} PROCEDURE stop; {Signal a real bad problem. Include close file statements.} BEGIN END;{Stop} FUNCTION wordify;{( st :string): word } {Changes a string to standard pascal word.} VAR i : integer; w1 : word; {A temporary buffer.} BEGIN FOR i := 1 TO wordsize DO w1[i] := ' '; FOR i := 1 TO length(st) DO w1[i] := st[i]; wordify := w1;{Set the value to return.} END;{wordify} FUNCTION equaltoken; {(var t1, t2 : token) : boolean;} {Returns true if t1=t2.} VAR i : integer; BEGIN i := 1; WHILE (t1[i] = t2[i]) AND (i < wordspertoken) DO i := i + 1; equaltoken := (i = wordspertoken) AND (t1[i] = t2[i]); END;{equaltoken} FUNCTION lesstoken;{(var t1, t2 : token) : boolean;} {Returns true if t1<t2.} VAR i : integer; BEGIN i := 1; WHILE (t1[i] = t2[i]) AND (i < wordspertoken) DO i := i + 1; lesstoken := (t1[i] < t2[i]); END;{lesstoken} FUNCTION equalphrase; {(var p1, p2 : phrase) : boolean;} {Returns true if p1=p2.} BEGIN IF p1[1] = p2[1] THEN BEGIN IF p1[2] = p2[2] THEN BEGIN IF p1[3] = p2[3] THEN equalphrase := true ELSE equalphrase := false END ELSE equalphrase := false END ELSE equalphrase := false END;{equalphrase} FUNCTION lessphrase;{(var p1, p2 : phrase) : boolean;} {Returns true if p1<p2.} VAR i : integer; BEGIN i := 1; WHILE (p1[i] = p2[i]) AND (i < 3) DO i := i + 1; lessphrase := (p1[i] < p2[i]); END;{lessphrase} PROCEDURE scriptword;{(var w1 : word);} {Writes out a line.} VAR i : integer; BEGIN FOR i := 1 TO wordsize DO write(outputfile, w1[i]); write(outputfile, ' '); END;{scriptword} PROCEDURE scripttoken; { (var t1 : token);} {Writes out a token.} VAR i : integer; BEGIN FOR i := 1 TO wordspertoken DO write(outputfile, t1[i]); writeln(outputfile); END;{scripttoken} PROCEDURE skiptoend;{(var stopchar : char);} {Skips over everything until it hits a stop character.} VAR a : char; {something to get us through the file.} BEGIN read(inputfile, stopchar); IF stopchar = '{' THEN WHILE (stopchar <> '}') AND NOT eof(inputfile) DO read(inputfile, stopchar);{Scan to the end of the comment.} IF a = '}' THEN read(inputfile, stopchar); IF eof(inputfile) THEN BEGIN error('Premature end of file.'); stop {Take care of those nasty error messages.} END; WHILE (stopchar <> '.') AND (stopchar <> ';') AND (stopchar <> ':') DO BEGIN read(inputfile, stopchar); IF stopchar = '{' THEN WHILE (stopchar <> '}') AND NOT eof(inputfile) DO read(inputfile, stopchar);{Scan to the end of the comment.} IF a = '}' THEN read(inputfile, stopchar); IF eof(inputfile) THEN BEGIN error('Premature end of file.'); stop {Take care of those nasty error messages.} END END END; {Skiptoend} FUNCTION nextword; {(var stopchar : char) : word;} VAR loopcool : boolean; {Keeps track of the loop.} w1 : word; {Temporary word storage.} i : integer; {The usual role of drudgework. Stop lexicism. Free i's from counting.} a : char; {something to get us through the file.} BEGIN loopcool := true;{Set the boolean.} i := 1;{And the counter of the word.} read(inputfile, a); IF a = '{' THEN WHILE (a <> '}') AND NOT eof(inputfile) DO read(inputfile, a);{Scan to the end of the comment.} IF a = '}' THEN read(inputfile, a); IF eof(inputfile) THEN loopcool := false;{Pull off any leading spaces.} WHILE (a = ' ') AND NOT eof(inputfile) DO BEGIN read(inputfile, a); IF a = '{' THEN WHILE (a <> '}') AND NOT eof(inputfile) DO read(inputfile, a);{Scan to the end of the comment.} IF a = '}' THEN read(inputfile, a); END; IF a = ' ' THEN loopcool := false ELSE IF a = '(' THEN loopcool := false ELSE IF a = ')' THEN loopcool := false ELSE IF a = '=' THEN loopcool := false ELSE IF a = ':' THEN loopcool := false ELSE IF a = ';' THEN loopcool := false ELSE IF a = '.' THEN loopcool := false; WHILE loopcool DO BEGIN IF i <= wordsize THEN BEGIN w1[i] := a; i := i + 1 END; read(inputfile, a); IF a = '{' THEN WHILE (a <> '}') AND NOT eof(inputfile) DO read(inputfile, a);{Scan to the end of the comment.} IF a = '}' THEN read(inputfile, a); IF eof(inputfile) THEN loopcool := false;{Blow out of here.} IF a = ' ' THEN loopcool := false ELSE IF a = '(' THEN loopcool := false ELSE IF a = ')' THEN loopcool := false ELSE IF a = '=' THEN loopcool := false ELSE IF a = ':' THEN loopcool := false ELSE IF a = ';' THEN loopcool := false ELSE IF a = '.' THEN loopcool := false END;{Pad with spaces.} WHILE i <= wordsize DO BEGIN w1[i] := ' '; i := i + 1 END; stopchar := a;{Save the offending character.} nextword := w1 END;{nextword}END.
================================
APTPRINT
================================
UNIT APEprint;{APE 1.0 Copyright ⌐ 1988, Peter Wayner}{This is the code for version 1.0 of the APE compiler developed by Peter Wayner}{at Cornell University's Department of Computer Science. It is NOT in the public}{domain. It cannot be included as part of any other software without the }{written permission of the author.}{A version with windows, a much friendlier interface and a manual}{available for $45 from the author at 119 Ferris Place, Ithaca, NY 14850.}{A version for the IBM-PC is also available at the same price.} {Contains the printout routines.}INTERFACE USES APEglobals; PROCEDURE print; {Prints 'em out.}IMPLEMENTATION PROCEDURE scriptword (VAR w1 : word); {Writes out a line.} VAR i, j : integer; BEGIN j := wordsize; WHILE (w1[j] = ' ') AND (j > 0) DO j := j - 1; FOR i := 1 TO j DO write(outputfile, w1[i]); write(outputfile, ' '); END;{scriptword} PROCEDURE pphrase (phrasenum : integer); {Takes a phrase and prints it out neatly. Will handle recursion.} VAR p1 : phrase; {The local phrase variable.} i : integer; t2 : token; {The token of the connector.} placeholder : phrasepoint; {A time saver. No need to access the array twice.} PROCEDURE pside (side : integer); {prints left or right depending upon whether side:=1 or 3.} VAR i, j : integer; t1 : token; place2 : phrasepoint; {Another time saver.} BEGIN place2 := phrasemap[p1[side]]; IF place2 <> NIL THEN IF place2^.equals > 0 THEN BEGIN {We've been here before. Use the substitute token.} t1 := tokenmap[place2^.equals]^.t1;{get the token.} i := 1; WHILE (t1[i] <> 0) AND (i <= wordspertoken) DO BEGIN scriptword(uidmap[t1[i]]^.name); i := i + 1 END; END ELSE BEGIN write(outputfile, '('); pphrase(p1[side]); write(outputfile, ')'); END ELSE {It's not a connection, so it's a tokenid too!} BEGIN t1 := tokenmap[p1[side]]^.t1;{get the token.} i := 1; WHILE (t1[i] <> 0) AND (i <= wordspertoken) DO BEGIN scriptword(uidmap[t1[i]]^.name); i := i + 1 END; END END;{pside} BEGIN {pphrase} placeholder := phrasemap[phrasenum]; IF placeholder^.equals > 0 THEN BEGIN {Well here we are at an equality. Write it out so the reader knows where he is.} t2 := tokenmap[placeholder^.equals]^.t1; i := 1; WHILE (t2[i] <> 0) AND (i <= wordspertoken) DO BEGIN scriptword(uidmap[t2[i]]^.name); i := i + 1 END; write(outputfile, '=') END; p1 := placeholder^.p1; t2 := tokenmap[p1[2]]^.t1; i := 1; IF placeholder^.reversed THEN BEGIN pside(3); WHILE (t2[i] <> 0) AND (i <= wordspertoken) DO BEGIN scriptword(uidmap[t2[i]]^.name); i := i + 1 END; pside(1) END ELSE BEGIN pside(1); WHILE (t2[i] <> 0) AND (i <= wordspertoken) DO BEGIN scriptword(uidmap[t2[i]]^.name); i := i + 1 END; pside(3) END END;{pphrase} PROCEDURE depth (node : dagpoint); {Recursive decent printer. Prints in-order traversal of the dag.} VAR t1 : token; {Contains the token to be printed.} p1 : phrase; {A temporary phrase to get results for t1} i : integer; {A counter.} BEGIN IF NOT node^.visited THEN BEGIN IF node^.left = NIL THEN {At a leaf. Either both nil or neither nil.} BEGIN t1 := tokenmap[node^.phraseid]^.t1; write(outputfile, 'Describe :'); i := 1; WHILE (t1[i] <> 0) AND (i <= wordspertoken) DO BEGIN scriptword(uidmap[t1[i]]^.name); i := i + 1 END; writeln(outputfile); END ELSE BEGIN depth(node^.left); depth(node^.right); write(outputfile, 'Show how:'); pphrase(node^.phraseid); writeln(outputfile) END; node^.visited := true; END END;{depth} PROCEDURE print; {The main printing machine.} VAR finished : boolean; {The old end of loop condition.} minimum : integer; {Contains the minimum minimum id found so far.} dome : integer; {This contains the next integer to be done. do me.} i : integer; {A simple counter.} BEGIN writeln(outputfile, 'The Outline:'); writeln(outputfile); REPEAT finished := true; minimum := lastphraseid;{The largest minimum is lasttokenid. This is definitely >} dome := 0;{This one holds the minimum id found.} FOR i := lastphraseid DOWNTO 1 DO {Scan the list for the minimum id. This is the tree to search next.} IF NOT dagmap[i]^.visited AND dagmap[i]^.top THEN {This one needs to be done.} BEGIN finished := false; IF phrasemin[i] <= minimum THEN {Equals because we want the first node with the min.} BEGIN minimum := phrasemin[i]; dome := i END END; IF dome > 0 THEN depth(dagmap[dome]); UNTIL finished; END;END.{box4print}
================================
APTTOP
================================
PROGRAM apetop;{APE 1.0 Copyright ⌐ 1988, Peter Wayner}{This is the code for version 1.0 of the APE compiler developed by Peter Wayner}{at Cornell University's Department of Computer Science. It is NOT in the public}{domain. It cannot be included as part of any other software without the }{written permission of the author.}{A version with windows, a much friendlier interface and a manual}{available for $45 from the author at 119 Ferris Place, Ithaca, NY 14850.}{A version for the IBM-PC is also available at the same price.} USES APEglobals, APEutil, APEdata, APEprint, APEcon; PROCEDURE initialize; {Gets everything rolling.} VAR i : integer; idea : boolean; {A dummy variable to keep addword working.} w1 : word; {Something to hold the words.} BEGIN lastuid := 0; lasttokenid := 0; lastphraseid := 0; tokentop := NIL; {Set the top of the token stack.} FOR i := 0 TO hashsize DO hashmap[i] := NIL; stacktop := NIL; phrasetop := NIL; {Now store away all the words.} idea := true; w1 := wordify('IDEAS'); addword(w1, idea, ideanum); w1 := wordify('CONNECTORS'); addword(w1, idea, connum); w1 := wordify('CONNECTIONS'); addword(w1, idea, equnum);{Equations are often a synnonym for connections} w1 := wordify('LEFT'); addword(w1, idea, leftnum); w1 := wordify('RIGHT'); addword(w1, idea, rightnum); w1 := wordify('SYMETRIC'); addword(w1, idea, symnum); END; PROCEDURE scanline (idea : boolean); {Scans a line of connections storing words or ideas until all are stored.} {If idea is true than a line of ideas is being scanned, otherwise a line of } {connectors are being searched.} VAR stopchar : char; {The character that stops the nextword subroutine.} w1 : word; {A word that is being operated upon.} wordnum : integer; {The number of the word that it is turned into.} t1 : token; {The current token being stored.} tokencount : integer; {A placeholder in the current token.} symetric : integer; {0=symetric,1=left first,2=right first connector.} placeholder : tablepoint; {Holds the position in the word table when checkword is used.} connection : boolean; {A spurious variable to allow the addtoken procedure to work.} tokenid : integer; {Another one.} duplicate : boolean; {Not so spurious. If it is a duplicate, warn the sucker.} BEGIN connection := false; REPEAT {Scan through all lines until a period is encountered.} tokencount := 0; REPEAT {Scan through the line until something is found.} w1 := nextword(stopchar); IF w1[1] <> ' ' THEN {We've found a real word. This just prevents a blankword from crashing.} BEGIN addword(w1, idea, wordnum); tokencount := tokencount + 1; IF tokencount <= wordspertoken THEN t1[tokencount] := wordnum ELSE BEGIN error('Reached maximum words per token. Extra ignored.'); skiptoend(stopchar) END END UNTIL (stopchar = ';') OR (stopchar = ':') OR (stopchar = '.') OR eof(inputfile); IF tokencount > 0 THEN {There is something here to do.} BEGIN WHILE tokencount < wordspertoken DO {Clean up the rest of the token.} BEGIN tokencount := tokencount + 1; t1[tokencount] := 0 END; symetric := 0; IF (stopchar = ':') AND NOT idea THEN BEGIN {Decide what type of connector.} w1 := nextword(stopchar); IF checkword(w1, placeholder) THEN {A recognized word is found. See if it is the correct one.} IF placeholder^.uid = leftnum THEN symetric := 1 ELSE IF placeholder^.uid = rightnum THEN symetric := 2 ELSE IF placeholder^.uid = symnum THEN symetric := 0 ELSE error('Definition of connector must be followed by ''left'',''right'' or ''symetric.') ELSE {A real error is found.} error('Definition of connector must be followed by ''left'',''right'' or ''symetric.'); END; {Store it all away now.} addtoken(t1, idea, symetric, connection, tokenid, duplicate); IF duplicate THEN error('Duplicate token encountered.') END; WHILE (stopchar <> ';') AND (stopchar <> '.') AND NOT eof(inputfile) DO skiptoend(stopchar); UNTIL (stopchar = '.') OR eof(inputfile); END;{scanline} PROCEDURE scancentral; {Keeps everything rolling along. Begins the scanning and portions it out to everyone.} VAR idea : boolean; {True if we are in an idea segment.} w1 : word; {A variable to hold the nextword read.} stopchar : char; {This variable marks the end of the line.} placeholder : tablepoint; {Something needed to use checkword. placeholder^.uid is the uid of the word} BEGIN REPEAT w1 := nextword(stopchar); IF checkword(w1, placeholder) THEN {Yes the word is found. Do something.} IF placeholder^.uid = ideanum THEN {A new idea segment is begun.} BEGIN idea := true; scanline(idea); END ELSE IF placeholder^.uid = connum THEN {A new connector segment is begun.} BEGIN idea := false; scanline(idea); END ELSE IF placeholder^.uid = equnum THEN {A new connection segment is begun.} parsem;{Well if it gets to here, then the word is not cool. Ignore it and go on. Keep scanning words}{until a match is found or the end of file is reached.} UNTIL eof(inputfile); END;{scancentral}BEGIN Showtext; {Show the text window. Specific to Lightspeed Pascal for the Mac.} initialize; write('Inputfile name:'); readln(inputname); write('Outputfile name:'); readln(outputname); reset(inputfile, inputname); {Open the input-file.} rewrite(outputfile, outputname); {Open the output file and set it to the beginning.} scancentral; print; close(inputfile); close(outputfile)END.
